TITL DAI FIRMWARE D101-D23C  V1.1
        ORG   :D101
*
*
*
*  ================
*** STRING HANDLER ***
*  ================
*
*
*****************************
* INITIALISE STRING HANDLER *
*****************************
*
* Initialises a given size of string area.
* This routine is used once by RESET (C719), but
* without purpose. It belongs to another BASIC
* package of the firm DAI.
*
* Entry: None.
* Exit:  A=0, BCDEHL preserved. F corrupted.
*
SHINIT  XRA   A
        STA   :0000     Zero 0000
        RET
*
**********************
* APPEND TWO STRINGS *
**********************
*
* Appends two strings together to one new string
* by adding the 2nd string to the end of the 1st
* string.
*
* Entry: DE: Startaddress 1st string.
*            (1st byte is length byte).
*        HL: Startaddress 2nd string.
* Exit:  AFBCDE preserved.
*        HL: Points to new string.
*        Error if string too long.
*
SHAPP   PUSH  PSW
        PUSH  D
        LDAX  D         Get length 1st string
        ADD   M         Calc length new string
        JC    :DA38     Run error 'STRING TOO LONG'
 REM if length >255.
        PUSH  H         Save pntr 2nd string
        CALL  :D18B     Find place in Heap for
 REM new string
        PUSH  H         Save pntr to new string
        INX   H
        CALL  :D16D     Move 1st string to new loc.
        POP   D
        XTHL
        XCHG
        XTHL
        CALL  :D16D     Move 2nd string to new loc.
        POP   H         Get pntr to new string
        POP   D
        POP   PSW
        RET
*
***********************
* COMPARE TWO STRINGS *
***********************
*
* Compares two string character by character.
* No characters >=#80 are allowed.
*
* Entry: DE: beginaddr. 1st string.
*        HL: beginaddr. 2nd string.
* Exit:  ABCDEHL preserved.
*        Flags:     Z=1: Both strings ident.
*               S=1,Z=0: 2nd string longer.
*               S=0,Z=0: 1st string longer.
*
SHCOMP  PUSH  B
        PUSH  PSW
        PUSH  D
        PUSH  H
        LDAX  D         Get length 1st string
        MOV   B,A       Store it in B
        MOV   C,M       Length 2nd string in C
LD3     INX   D
        INX   H
        MOV   A,B
        SUI   :01       Check 1st string empty
        MOV   B,A       Save rest of bytes
        JC    :D145     If 1st string empty
        MOV   A,C
        SUI   :01       Check 2nd string empty
        MOV   C,A       Save rest of bytes
        INR   A
        INR   A
        JC    :D13F     If 2nd string empty
        LDAX  D         Get byte 1st string
        CMP   M         and compare it with 2nd
        JZ    :D128     If identical: cont. test
LD4     POP   H
        POP   D
        POP   B
        MOV   A,B       Restore A
        POP   B
        RET
 REM
* If 1st string empty:
 REM
LD5     MOV   A,C       Get length 2nd string
        ORA   A
        JZ    :D13F     If also empty: abort, Z=1
        XRA   A
        DCR   A         Z=0
        JMP   :D13F     Quit
*
******************************************
* EXTRACT A SUBSTRING FROM THE MIDDLE OF *
* ANOTHER STRING                         *
******************************************
*
* Entry: HL points to string.
*        D  offset substring.
*        E  length substring.
* Exit:  If O.K.: HL points to substring.
*        Else: Jump to error.
*        AF corrupted. BCDE preserved.
*
SHMID   PUSH  B
        PUSH  D
SHM05   MOV   A,M       Get length string
        SUB   D         Minus offset substring
        JC    :DA15     Run error 'NUMBER OUT OF
 REM RANGE' if offset too big
        SUB   E         Minus length substring
        JC    :DA15     Run error 'NUMBER OUT OF
 REM RANGE' if length too big
SHM08   MOV   A,D       Get offset
        CALL  :DE30     Calc beginaddr substring
        INX   H
        PUSH  H         Save begin substring
        MOV   A,E       Get length substring
        CALL  :D18B     Find place in Heap for
 REM substring
        POP   D         Get begin substring
        PUSH  H
        CALL  :D173     Move substring into Heap
        POP   H
        POP   D
        POP   B
        RET
*
***************************
* TRANSFER OF STRING DATA *
***************************
*
* Copies strings from one place to another.
*
* Start at SCOPF: Transfer known string from DE
*                 to HL.
* Start at SCOPT: Transfer string into limited
*                 space of HL.
*
* Entry: DE: Startaddr. string to be transferred.
*        HL: Destination address.
*            1st bytes are length bytes.
* Exit:  Both DE + HL point to byte after string.
*        BC preserved; A=FF, CY=1.
*
SCOPF   LDAX  D         Get length
        INX   D         Pnt to 1st byte
        JMP   :D175
*
SHCOPY  INX   D         Pnt to 1st byte of string
SCOPT   MOV   A,M       Get available space
        INX   H         Pnt to 1st place to store
LD9     PUSH  B
        MOV   B,A       Available space/space reqd
 REM in B
LD10    MOV   A,B       Get space still available
        SUI   :01       Decr. space available
        MOV   B,A       and save it
        JC    :D185     Jump if ready
        LDAX  D         Get byte to be transferred
        MOV   M,A       and transfer it
        INX   D         Pnt to next byte
        INX   H         Pnt to next place
        JMP   :D177     Transfer next byte
*
LD11    POP   B
        RET
*
*************************
* RELINQUISH HEAP SPACE *
*************************
*
* Clears a string in the heap.
*
* Entry: HL points to 2nd length byte of string.
* Exit:  HL points to 2nd length byte of cleared
*        string. AFBCDE preserved.
*
SHREL   DCX   H
        JMP   :D236     Clear Heap entry.
*
**************************************
* REQUEST SPACE IN HEAP FOR A STRING *
**************************************
*
* Finds a place in the heap for a new string.
*
* Entry: A: Required space.
* Exit:  AFBCDE preserved.
*        HL points to length of reserved area.
*        Error if no space available.
*
SHREQ   PUSH  D
        MVI   D,:00     ) Required space in DE
        MOV   E,A       )
        CALL  :D1C5     Run Heap request
        INX   H
        POP   D
        RET
*
*
*  ==============
*** HEAP HANDLER ***
*  ==============
*
*
*************************************
* INIT. HEAP SPACE TO ALL AVAILABLE *
*************************************
*
* The pointers for textbuffer and symboltable
* are updated correctly according to the requested
* Heapsize. The Heap is cleared: It starts with
* HSIZE-4 IOR #8000 and ends with #7FFF.
*
* Entry: DE: HEAP size (<32K).
* Exit:  BC preserved. AFDEHL corrupted.
*        Error if insufficient space.
*
HINIT   LHLD  :029F     Start text buffer in HL
        PUSH  D
        PUSH  H
        PUSH  D
        XCHG            Start textbuf in DE
        LHLD  :029B     Start Heap in HL
        XCHG
        CALL  :DE1A     Calc current heapsize
        XCHG            Store it in DE
        POP   H         Get new HEAP size
        CALL  :DE1A     Calculate difference
        POP   D         Get old start textbuf
        CALL  :C9D1     Move textbuf and symtab
        SHLD  :029F     Update start textbuf
        POP   D         Get new HEAP size
        LHLD  :029B     Get startaddr HEAP
        DCX   D
        DCX   D
        DCX   D
        DCX   D         HSIZE-4
        MOV   A,D
        ORI   :80       Free space available
        MOV   M,A       ) Set start Heap to
        INX   H         ) HSIZE-4 IOR #8000
        MOV   M,E       )
        INX   H
        DAD   D         Get end HEAP -2
        MVI   M,:7F     ) Set it to
        INX   H         ) #7FFF
        MVI   M,:FF     ) (end marker)
        RET
*
****************
* HEAP REQUEST *
****************
*
HREQU   RST   1         Run heap request
        DATA  :0F
        RET
        MOV   A,E       ] Get signbyte in A
        MVI   E,:00     ] Clear E
        JP    :C08C     ] Compare if both nrs same
 REM sign
        JMP   :C0A4     ] Else: abort
*
************************
* part of EDIT (2EEC0) *
************************
*
* Prints a text line.
*
LD15    JZ    :EEEC     (2) If char=0
        JP    :EEDE     (2) Cont for char #01-7F
        INX   H         Next pos in textbuf
        JMP   :EED2     (2) Ignore char >= #80
*
*******************************************
* INPUT SCANNING: CHECK SOURCE AND INPUTS *
*******************************************
*
* Part of D6BB.
* Checks if input from keyboard or from DINC.
* Checks also for any new inputs.
*
MPT29   LDA   :0296     Get input direction
        ORA   A
        JNZ   :02E0     Jump if input from DINC
 REM
* If input from keyboard:
 REM
IN0     CALL  :D6A5     Check if new keys pressed
        JMP   :D6C1     Into keyb.scanning
*
******************************
* part of FPT COMPARE (C079) *
******************************
*
* Entry: Contents MACC in ABCD, exp.byte in E.
*        HL points to exp.byte MEM.
*
LD17    MOV   A,B
        INX   H
        ANA   M         AND 1st bytes both mantissas
        MOV   A,M
        DCX   H         Pnts to exp.byte MEM
        JM    :D1F5     Jump if both 1st mantissa
 REM bits are '1'
        CMP   B         Comp both 1th mantissa bytes
        CMC             CY=0 if mantissa MACC >
 REM mantissa MEM
        JMP   :C09F     Quit
*
LD18    MOV   A,E       Get exp.byte MACC
        XRA   M         XOR both exponents
        ANI   :40       Check if only 1 exp. neg.
        MOV   A,E       Get exp.byte MACC
        JMP   :C087     Back to main routine
*
************************
* part of EDIT (2EE7B) *
************************
*
* Skip to B'th position on line.
*
LD19    MOV   A,M       Get char in A
        ORA   A         Set flags on it
        JM    :EE94     (2) Ignore char >= #80
        MOV   A,B       Get pos. required
        CMP   C         Reached ?
        MOV   A,M       Get char
        JMP   :EE82     (2)
*
********
* DATA *
********
*
MSG01   DATA  :0D       CR
        DBL   :6FDB     'SOME INPUT IGNORED'
        DATA  :00
*
**********************************
* part of UNDERFLOW ERROR (C065) *
**********************************
*
LD21    RST   4         Copy operand to MACC
        DATA  :0C
        LXI   H,:0004
        JMP   :C04F     Cont on (00D0/1)+4
*
****************************************
* part of RUN 'CLEAR' (cont. of 0E6B5) *
****************************************
*
MPT44   CALL  :DE1A     ] Calc difference old/new
        PUSH  H         ] Preserve result
        CALL  :CB23     ] Empty heap and symtab,
 REM move program to after heap
        LHLD  :0100     Get pntr to current line
        MOV   A,H
        ORA   L
        POP   D         Get difference
        RZ              Abort if direct cmd
        DAD   D         ] Add difference to pntr
 REM current line
        JMP   :CEBB     ]
        DATA  :FF       ]
*
********************************
* part of HEAP REQUEST (3E9AD) *
********************************
*
* Checks if end of Heap reached.
*
HRQ80   CPI   :7F       End marker ?
        JNZ   :E9FA     (3) Jump if not
        MOV   A,E       Get 2nd byte in A
        INR   A
        JNZ   :E9FA     (3) Jump if it was <> FF
        MVI   A,:07     If end of Heap reached:
        JMP   :D9F5     Run error 'OUT OF STRING
 REM SPACE'
*
**********************
* CLEAR A HEAP ENTRY *
**********************
*
* A Heap entry is erased by setting the msb of
* the first byte to 1.
*
* Entry: HL: Points to byte.
* Exit:  All registers preserved.
*
HREL    PUSH  PSW
        MOV   A,M       Get byte
        ORI   :80       Set msb=1
        MOV   M,A       Store byte
        POP   PSW
        RET
*
*
*
        END